home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / CODEAPP.ZIP / FILEDLG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-18  |  5.3 KB  |  205 lines
  1. unit Filedlg;
  2. (*-----
  3.     File: FILEDLG.PAS for Project CODEAPP.DPR
  4. -----*)
  5.  
  6. interface
  7.  
  8. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  9.   StdCtrls, FileCtrl, SysUtils, Grids, Outline, DirOutln, Dialogs,
  10.   PrintDlg, FileFunc;
  11.  
  12. type
  13.   TSelectFileDlg = class(TForm)
  14.     OKBtn: TBitBtn;
  15.     CancelBtn: TBitBtn;
  16.     HelpBtn: TBitBtn;
  17.     GroupBox1: TGroupBox;
  18.     FileInfo: TLabel;
  19.     Label3: TLabel;
  20.     Label4: TLabel;
  21.     Label5: TLabel;
  22.     Label6: TLabel;
  23.     Label7: TLabel;
  24.     Edit1: TComboBox;
  25.     FileListBox1: TFileListBox;
  26.     FilterComboBox1: TFilterComboBox;
  27.     DriveComboBox1: TDriveComboBox;
  28.     DirectoryListBox1: TDirectoryListBox;
  29.     procedure FileListBox1Change(Sender: TObject);
  30.     procedure FormCreate(Sender: TObject);
  31.     procedure OKBtnClick(Sender: TObject);
  32.     procedure CancelBtnClick(Sender: TObject);
  33.     procedure DriveComboBox1Change(Sender: TObject);
  34.     procedure Edit1Click(Sender: TObject);
  35.     procedure FileListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  36.       Shift: TShiftState; X, Y: Integer);
  37.     procedure DirectoryListBox1Change(Sender: TObject);
  38.     procedure Edit1KeyDown(Sender: TObject; var Key: Word;
  39.       Shift: TShiftState);
  40.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  41.     procedure HelpBtnClick(Sender: TObject);
  42.     procedure FileListBox1DblClick(Sender: TObject);
  43.     procedure FileListBox1KeyPress(Sender: TObject; var Key: Char);
  44.     procedure FormActivate(Sender: TObject);
  45.   private
  46.     { Private declarations }
  47.     function HaveFileName: boolean;
  48.   public
  49.     { Public declarations }
  50.     FileSpec: string;      { the chosen file /w path }
  51.     FilePath: string;
  52.     FileTypes: string;     {file selection filter}
  53.   end;
  54.  
  55. var
  56.   SelectFileDlg: TSelectFileDlg;
  57.  
  58. implementation
  59.  
  60. {$R *.DFM}
  61.  
  62. function AddBackSlash(const FDir: string): string;
  63. begin
  64.   if (length(FDir) < 255) and (FDir[length(FDir)] <> '\') then
  65.     Result := Fdir+'\'
  66.   else
  67.     Result := FDir;
  68. end;
  69.  
  70. procedure TSelectFileDlg.FileListBox1Change(Sender: TObject);
  71. {-Show # of files in list}
  72. begin
  73.   Label6.Caption := 'Files: '+
  74.     IntToStr(FileListBox1.Items.Count);
  75.   with FileListBox1 do
  76.     if ItemIndex < 0 then
  77.       FileInfo.Caption := '';
  78. end;
  79.  
  80. procedure TSelectFileDlg.FormCreate(Sender: TObject);
  81. begin
  82.   FileSpec := '';      { the chosen file /w path }
  83.   FilePath := '';
  84.   FileTypes := '';     {file selection filter}
  85.   Left := Screen.Width - Width;
  86.   Top := 0;
  87. end;
  88.  
  89. function TSelectFileDlg.HaveFileName: boolean;
  90. var
  91.   F: TSearchRec;
  92. begin
  93.   with FileListBox1 do
  94.     if ItemIndex >= 0 then
  95.     begin
  96.       Result := True;
  97.       FilePath := AddBackSlash(Directory);
  98.       FileSpec := FilePath+Items.Strings[ItemIndex];
  99.       Edit1.Text := Items.Strings[ItemIndex];
  100.       Edit1.Items.Add(Items.Strings[ItemIndex]);
  101.       if GetFileInfo(Items.Strings[ItemIndex], F) then
  102.         FileInfo.Caption := ShowFileStats(F)
  103.       else
  104.         FileInfo.Caption := 'FILE INFO UNAVAILABLE';
  105.     end
  106.     else
  107.     begin
  108.       Result := False;
  109.       MessageBeep(64);
  110.     end
  111. end;
  112.  
  113. procedure TSelectFileDlg.FileListBox1DblClick(Sender: TObject);
  114. begin
  115.   if HaveFileName then
  116.     Close
  117. end;
  118.  
  119. procedure TSelectFileDlg.FileListBox1MouseDown(Sender: TObject;
  120.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  121. {-Select a file from list}
  122. begin
  123.   if HaveFileName then
  124.     FileListBox1.BeginDrag(False);
  125. end;
  126.  
  127. procedure TSelectFileDlg.OKBtnClick(Sender: TObject);
  128. begin
  129.   if HaveFileName then
  130.     Close;
  131. end;
  132.  
  133. procedure TSelectFileDlg.FileListBox1KeyPress(Sender: TObject;
  134.   var Key: Char);
  135. begin
  136.   OKBtnClick(Sender);
  137. end;
  138.  
  139. procedure TSelectFileDlg.CancelBtnClick(Sender: TObject);
  140. begin
  141.   FileSpec := '';
  142.   Close
  143. end;
  144.  
  145. procedure TSelectFileDlg.DriveComboBox1Change(Sender: TObject);
  146. begin
  147.   DirectoryListBox1.Drive := DriveComboBox1.Drive;
  148. end;
  149.  
  150. procedure TSelectFileDlg.Edit1Click(Sender: TObject);
  151. var
  152.   FN: string;
  153. begin
  154.   if Edit1.Text <> '' then
  155.   begin
  156.     FN := UpperCase(FileListBox1.Directory+Edit1.Text);
  157.     FileInfo.Caption := FN;
  158.     FileSpec := FN;
  159.   end;
  160. end;
  161.  
  162. procedure TSelectFileDlg.DirectoryListBox1Change(Sender: TObject);
  163. {-Make file list match Directory list}
  164. begin
  165.   FileListBox1.Directory := DirectoryListBox1.Directory;
  166. end;
  167.  
  168. procedure TSelectFileDlg.Edit1KeyDown(Sender: TObject; var Key: Word;
  169.   Shift: TShiftState);
  170. begin
  171.   if (Key = vk_Return) and (Shift = []) then
  172.     if (Pos('*',Edit1.Text) <> 0) or (Pos('?',Edit1.Text) <> 0) then
  173.       FileListBox1.Mask := Edit1.Text
  174.     else
  175.     begin
  176.       FileSpec := Edit1.Text;
  177.       close
  178.     end
  179. end;
  180.  
  181. procedure TSelectFileDlg.Edit1KeyPress(Sender: TObject; var Key: Char);
  182. begin
  183.   if Key = #13 then Key := #0;
  184. end;
  185.  
  186. procedure TSelectFileDlg.HelpBtnClick(Sender: TObject);
  187. {-Give user a clue or two}
  188. begin
  189.   MessageDlg('Select a File by highlighting the desired directory and'#13+
  190.   'and file name. Then select it by clicking on OK, or'#13+
  191.   'dragging the name to the main form and dropping it there.',
  192.   mtInformation, [mbCancel], 0);
  193. end;
  194.  
  195.  
  196. procedure TSelectFileDlg.FormActivate(Sender: TObject);
  197. begin
  198.   if FileSpec <> '' then
  199.     DirectoryListBox1.Directory := ExtractFilePath(FileSpec);
  200.   FileListBox1.Update;
  201.   DriveComboBox1.Drive := DirectoryListBox1.Drive;
  202. end;
  203.  
  204. end.
  205.